home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / needac2a / midiplay.bas < prev    next >
Encoding:
BASIC Source File  |  1999-09-27  |  2.3 KB  |  58 lines
  1. 'www.errorrdomain.com
  2. Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  3. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplication As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal FileStr As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  4.  
  5. Global SongFileName  As String  'File Name of the midi file
  6. Global Index As Integer         'Element counter for SongTitleArrray()
  7. Global CRLF As String           'Carriage Return and Line Feed
  8. Global SongLength As String     'Variable for length of time of a song
  9.  
  10. ' low level MIDI Functions
  11. Declare Function MidiOutOpen Lib "mmsystem.dll" (hMidiOut As Long, ByVal DeviceId As Integer, ByVal C As Long, ByVal I As Long, ByVal F As Long) As Integer
  12. Declare Function MidiOutShortMsg Lib "mmsystem.dll" (ByVal hMidiOut As Integer, ByVal MidiMessage As Long) As Integer
  13. Declare Function MidiOutGetNumDevs Lib "mmsystem.dll" () As Integer
  14. Declare Function MidiOutClose Lib "mmsystem.dll" (ByVal hMidiOut As Integer) As Integer
  15. Declare Function MidiOutReset Lib "mmsystem.dll" (ByVal hMidiOut As Integer) As Integer
  16.  
  17.  
  18. Global MidiEventOut, MidiNoteOut, MidiVelOut As Long
  19.  
  20. Global hMidiOut As Long
  21. Global hMidiOutCopy As Long 'integer
  22. 'Global MidiOpenError As String
  23. Global MidiOpenError As Integer
  24. Global Const MIDI_MAPPER = -1
  25.  
  26. ' The current Midi Channel out set on MidiPlayer form
  27. Global MidiChannelOut As Integer
  28.  
  29. Function FileExists (FileName As String) As Integer
  30.     'This sub checks for the existance of any filename passed to it
  31.  
  32.     If Len(Dir$(FileName)) Then
  33.         FileExists = True
  34.     Else
  35.         FileExists = False
  36.     End If
  37. End Function
  38.  
  39. Sub MidiReset ()
  40.  
  41.     'This sub will reset the midi sequencer
  42.     'These are not MCI commands, but deal directly with the device
  43.     
  44.     'Open Midi Out while song is not playing
  45.     
  46.     'hMidiOut is filled with a value upon successful completion
  47.     MidiOpenError = MidiOutOpen(hMidiOut, MIDI_MAPPER, 0, 0, 0)
  48.     hMidiOutCopy = hMidiOut
  49.     
  50.     a% = MidiOutReset(hMidiOutCopy)
  51.     'Both these functions take a second or two to complete,
  52.     'therefore, use DoEvents to wait for them.
  53.     DoEvents
  54.     b% = MidiOutClose(hMidiOutCopy)
  55.     DoEvents
  56. End Sub
  57.  
  58.